home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mtmenus.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  14.9 KB  |  442 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtMenus;
  23.  
  24. (*----------------------------------------------------------------------*
  25.  * Int. Vers | Datum    | Name | Žnderung                               *
  26.  *-----------+----------+------+----------------------------------------*
  27.  *  3.00     | 18.01.92 |  Hp  |                                        *
  28.  *-----------+----------+------+----------------------------------------*)
  29.  
  30.  
  31.  
  32. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  33. (*                                              *)
  34. (*$R-   Range-Checks                            *)
  35. (*$S-   Stack-Check                             *)
  36. (*                                              *)
  37. (*----------------------------------------------*)
  38.  
  39.  
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  47.  
  48.  
  49.  
  50.  
  51. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  52.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  53.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  54.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  55.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  56.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  57.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  58.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65. FROM SYSTEM     IMPORT  ADDRESS, ADR, TSIZE;
  66. FROM MagicAES   IMPORT  GBOX, GTEXT, GBOXTEXT, GIBOX, GSTRING, GTITLE,
  67.                         Exit, DISABLED, OBJECT, ObjcDraw, ObjcFind,
  68.                         BEGMCTRL, ENDMCTRL, WindUpdate, WFFULLXYWH, WindGet,
  69.                         FormButton, GrafHandle, MUKEYBD, MUBUTTON, MUM1, 
  70.                         MUM2, MUMESAG, MUTIMER, EvntMulti, AESIntIn, AESIntOut,
  71.                         AESCall;
  72. FROM mtAppl     IMPORT  PrivateWS, MouseOn, MouseOff, MouseArrow,
  73.                         CharWidth, CharHeight, BoxWidth, BoxHeight;
  74. FROM mtArea     IMPORT  AREA, NewAREA, DisposeAREA, FreeArea, SaveArea,
  75.                         CopyArea, RestoreArea;
  76. FROM mtUtils    IMPORT  tRect, tObjcTree, Bounce, ScanFlags, SearchType,
  77.                         CalcArea;
  78. FROM mtMenubase IMPORT  SameLength, DoEvent, ScreenDim, DrawBar, MenuKeyboard,
  79.                         PlaceOnScreen;
  80. FROM MagicStrings  IMPORT  Assign, Append, Length;
  81. IMPORT  MagicAES, MagicVDI;
  82.  
  83.  
  84. CONST   MaxObjects =    51;
  85.         Links =         Bit0;
  86.         Rechts =        Bit1;
  87.  
  88. CONST   Enter =         072H;
  89.         Return =        01CH;
  90.         CurUp =         048H;
  91.         CurDown =       050H;
  92.         CurLeft =       04BH;
  93.         CurRight =      04DH;
  94.         Undo =          061H;
  95.  
  96. TYPE    tString =       ARRAY [0..40] OF CHAR;
  97.  
  98.  
  99. TYPE    MENUBAR =       POINTER TO Menubar;
  100.         Menubar =       RECORD
  101.                          line:  ARRAY [0..255] OF CHAR;
  102.                          tree:  tObjcTree;
  103.                          num:   sINTEGER;
  104.                          win:   sINTEGER;
  105.                          sub:   sINTEGER;
  106.                          start: sINTEGER;
  107.                          draw:  sINTEGER;
  108.                          spos:  sINTEGER;
  109.                          entry: ARRAY [0..MaxObjects] OF RECORD
  110.                                  text: ARRAY [0..40] OF CHAR;
  111.                                  width: sINTEGER;
  112.                                  pos:   sINTEGER;
  113.                                 END;
  114.                          react: RECORD
  115.                                  x: sINTEGER;
  116.                                  y: sINTEGER;
  117.                                  w: sINTEGER;
  118.                                  h: sINTEGER;
  119.                                 END;
  120.                         END;
  121.  
  122.  
  123. VAR     Dropdown:       ARRAY [0..MaxObjects] OF OBJECT;
  124.         menuArea:       AREA;
  125.         BAR:            MENUBAR;
  126.         b:              sBITSET;
  127.         bool, rekExit:  BOOLEAN;
  128.         screen:         tRect;
  129.         mWidth:         sINTEGER;
  130.         mHeight:        sINTEGER;
  131.         ScrollStr:      ARRAY [0..9] OF CHAR;
  132.         config:         Config;
  133.         Char3:          sINTEGER;
  134.         Char6:          sINTEGER;
  135.         tr:             RECORD
  136.                          adr: ADDRESS;
  137.                          d1, d2: sINTEGER;
  138.                         END;
  139.  
  140.  
  141. PROCEDURE GetMenu (mx, my: sINTEGER): sINTEGER;
  142. VAR j: sINTEGER;
  143. BEGIN
  144.  WITH BAR^ DO
  145.   WITH react DO
  146.    IF (my > y) AND (my < (y + h)) THEN
  147.     IF (mx > x) AND (mx < (x + 3 * CharWidth)) THEN  RETURN -2;  END;
  148.     IF (mx > (x + Char3) - 1) AND (mx < (x + Char6)) THEN  RETURN -3;  END;
  149.     FOR j:= start TO draw DO
  150.      IF (mx >= (x + entry[j].pos)) AND
  151.         (mx <= (x + entry[j].pos + entry[j].width)) THEN
  152.       RETURN j;
  153.      END;
  154.     END;
  155.    END;
  156.   END;
  157.  END;
  158.  RETURN -1; 
  159. END GetMenu;
  160.  
  161.  
  162. PROCEDURE DoMenu (t: tObjcTree; VAR j: sINTEGER): sINTEGER;
  163. VAR mx, my, ox, oy, i, jj, o: sINTEGER;
  164.     ob, oldob, taste, scan, clicks: sINTEGER;
  165.     button, kbshift, event: sBITSET;
  166.     ascii: CHAR;
  167.     steigaus: BOOLEAN;
  168.  
  169.  PROCEDURE DoDraw (ob: sINTEGER);
  170.  BEGIN
  171.   IF ob > 0 THEN  MouseOff;  DrawBar (t, ob);  MouseOn;  END;
  172.  END DoDraw;
  173.  
  174. BEGIN
  175.  oldob:= -1;  ob:= -1;  ox:= -1;  oy:= -1;
  176.  LOOP
  177.   event:= DoEvent (mx, my, button, scan);
  178.  
  179.   (* Teste ob anderes Men selektiert *)
  180.   IF config # pull THEN
  181.    jj:= GetMenu (mx, my);
  182.    CASE jj OF
  183.     -3:   DoDraw (ob);  j:= -3;  RETURN -1;|
  184.     -2:   DoDraw (ob);  j:= -2;  RETURN -1;|
  185.     -1:   | (* Nix tun *)
  186.     ELSE  IF (jj # j) THEN  DoDraw (ob);  j:= jj;  RETURN -1;  END;
  187.    END; (* CASE *)
  188.   END; (* config # pull *)
  189.   
  190.   (* Teste welches Objekt selektiert *)
  191.   IF (mx # ox) OR (my # oy) THEN
  192.    ox:= mx;  oy:= my;  ob:= MagicAES.ObjcFind (t, 0, MaxObjects, mx, my);
  193.    IF (ob # oldob) AND (ob > 0) THEN
  194.     DoDraw (oldob);  DoDraw (ob);  oldob:= ob;
  195.    ELSIF (ob < 0) AND (oldob > 0) THEN
  196.     DoDraw (oldob);  oldob:= -1;
  197.    END;
  198.   END;
  199.  
  200.   IF (config = pull) THEN
  201.    steigaus:= FALSE;
  202.    LOOP
  203.     MagicAES.GrafMkstate (mx, my, button, kbshift);
  204.     o:= MagicAES.ObjcFind (t, 0, MaxObjects, mx, my);
  205.     IF o # ob THEN  EXIT;  END;
  206.     IF NOT (Links IN button) THEN  steigaus:= TRUE;  EXIT;  END;
  207.    END;
  208.    IF steigaus THEN  EXIT;  END;
  209.   ELSIF (MUKEYBD IN event) THEN
  210.    IF MenuKeyboard (t, scan, 1, oldob, ob) THEN  EXIT;  END;
  211.    IF ob # oldob THEN  DoDraw (oldob);  DoDraw (ob);  oldob:= ob;  END;
  212.   ELSIF (MUBUTTON IN event) THEN
  213.    EXIT;
  214.   END; (* IF (MUKEYBD IN event) *)
  215.  END; (* LOOP *)
  216.  IF ob > 0 THEN
  217.   IF DISABLED IN t^[ob].obState THEN  RETURN -1;  ELSE  RETURN ob;  END;
  218.  ELSE
  219.   RETURN -1;
  220.  END;
  221. END DoMenu;
  222.  
  223.  
  224. PROCEDURE MakeMenu (subnum: sINTEGER): sINTEGER;
  225. VAR maxW, maxH, n, i, j, ob, offset: sINTEGER;
  226. BEGIN
  227.  j:= 0;  n:= 1;  maxW:= 0;  maxH:= 0;
  228.  (*-- Basisobjekt --*)
  229.  Dropdown[0].obNext:=    -1;
  230.  Dropdown[0].obHead:=    -1;
  231.  Dropdown[0].obTail:=    -1;
  232.  Dropdown[0].obType:=    GBOX;
  233.  Dropdown[0].obFlags:=   {};
  234.  Dropdown[0].obState:=   {};
  235.  Dropdown[0].obSpec.Box.char:=  0C;
  236.  Dropdown[0].obSpec.Box.frame:= 377C;
  237.  Dropdown[0].obSpec.Box.flags:= {Bit12, Bit11};
  238.  Dropdown[0].obX:=       0;
  239.  Dropdown[0].obY:=       0;
  240.  Dropdown[0].obWidth:=   0;
  241.  Dropdown[0].obHeight:=  0;
  242.  ob:= BAR^.sub + 1;
  243.  FOR j:= 1 TO subnum DO  ob:= BAR^.tree^[ob].obNext;  END;
  244.  IF ob < BAR^.sub THEN  RETURN -1;  END;
  245.  offset:= ob - 1;
  246.  j:= BAR^.tree^[ob].obHead;
  247.  (*-- Objekte addieren --*)
  248.  LOOP
  249.   i:= ScanFlags (BAR^.tree, SearchType, j, GSTRING);
  250.   IF BAR^.tree^[i].obWidth > maxW THEN  maxW:= BAR^.tree^[i].obWidth;  END;
  251.   Dropdown[n].obNext:=    -1;
  252.   Dropdown[n].obHead:=    -1;
  253.   Dropdown[n].obTail:=    -1;
  254.   Dropdown[n].obType:=    BAR^.tree^[i].obType;
  255.   Dropdown[n].obFlags:=   BAR^.tree^[i].obFlags;
  256.   Dropdown[n].obState:=   BAR^.tree^[i].obState;
  257.   Dropdown[n].obSpec.StringPtr:= BAR^.tree^[i].obSpec.StringPtr;
  258.   Dropdown[n].obX:=       0;
  259.   Dropdown[n].obY:=       maxH;
  260.   Dropdown[n].obWidth:=   BAR^.tree^[i].obWidth;
  261.   Dropdown[n].obHeight:=  CharHeight;
  262.   MagicAES.ObjcAdd (ADR(Dropdown), 0, n);
  263.   INC (n);  INC (maxH, CharHeight);  j:= i + 1;
  264.   IF i = BAR^.tree^[ob].obTail THEN  EXIT;  END;
  265.  END;
  266.  FOR i:= 0 TO n - 1 DO  Dropdown[i].obWidth:= maxW;  END;
  267.  Dropdown[0].obHeight:= maxH;
  268.  RETURN offset;
  269. END MakeMenu;
  270.  
  271.  
  272. PROCEDURE NewMenu (menu: ADDRESS; VAR bar: MENUBAR): BOOLEAN;
  273. VAR i, d: sINTEGER;
  274. BEGIN
  275.  ALLOCATE (bar,  TSIZE (Menubar));  
  276.  IF bar = NIL THEN  RETURN FALSE;  END;
  277.  WITH bar^ DO
  278.   spos:= 6 * CharWidth;  i:= 3;  num:= 0;  tree:= menu;
  279.   LOOP
  280.    Assign (tree^[i].obSpec.StringPtr^, entry[num].text);
  281.    d:= Length (tree^[i].obSpec.StringPtr^);
  282.    entry[num].width:= d * CharWidth;
  283.    entry[num].pos:= 0;
  284.    IF i = tree^[2].obTail THEN  EXIT;  END;
  285.    INC (i);  INC (num);
  286.   END;
  287.   sub:= i + 1;
  288.   start:= 0;
  289.  END;
  290.  RETURN TRUE;
  291. END NewMenu;
  292.  
  293.  
  294. PROCEDURE FreeMenu (VAR bar: MENUBAR);
  295. BEGIN
  296.  IF BAR = bar THEN BAR:= NIL; END;
  297.  DEALLOCATE (bar, 0);    bar:= NIL;
  298. END FreeMenu;
  299.  
  300.  
  301. PROCEDURE DrawMenu (bar: MENUBAR; window: sINTEGER; VAR rect: ARRAY OF LOC);
  302. VAR i, l: sINTEGER;
  303.     r:    tRect;
  304.     pr:   POINTER TO tRect;
  305. BEGIN
  306.  IF bar # NIL THEN
  307.   pr:= ADR (rect);
  308.   MagicAES.WindGet (window, MagicAES.WFWORKXYWH, r);
  309.   mWidth:= r.x + r.w;  mHeight:= r.y + r.h;
  310.   (* Reaktions-Rechteck berechnen *)
  311.   WITH bar^ DO
  312.    win:= window;
  313.    react.x:= r.x;  react.y:= r.y - BoxHeight;
  314.    react.w:= r.w;  react.h:= BoxHeight;
  315.    pr^.x:= react.x;  pr^.y:= react.y;  pr^.w:= react.w;  pr^.h:= react.h;
  316.    l:= spos;  i:= start;  Assign(ScrollStr, line);
  317.    WHILE (i <= num) AND ((l + entry[i].width) < (r.w - BoxWidth)) DO
  318.     Append (entry[i].text, line);  
  319.     entry[i].pos:= l;  INC (l, entry[i].width);  INC (i);
  320.    END;
  321.    draw:= i - 1;  tr.adr:= ADR(line);  tr.d1:= 0;  tr.d2:= 0;
  322.    MagicAES.WindSet (window, MagicAES.WFINFO, tr);
  323.   END; 
  324.   MagicAES.WindGet (0, MagicAES.WFTOP, r);
  325.   IF r.x = window THEN  BAR:= bar;  END;
  326.  END;
  327. END DrawMenu;
  328.  
  329.  
  330. PROCEDURE HandleMenu (VAR menu, eintrag: sINTEGER);
  331. CONST Links = Bit0;
  332. TYPE tScrol = (links, rechts);
  333. VAR  i, j, mx, my, scan, off, drp: sINTEGER;
  334.      scrol: tScrol;
  335.      b, sr: tRect;
  336.      button, s: sBITSET;
  337.      newmen: BOOLEAN;
  338.  
  339.  PROCEDURE InvertMenu;
  340.  BEGIN
  341.   MouseOff;   MagicVDI.FillRectangle (PrivateWS, b);  MouseOn;
  342.  END InvertMenu;
  343.  
  344.  PROCEDURE ScrollMenu (dir: sINTEGER);
  345.  VAR i, l: sINTEGER;
  346.      do:   BOOLEAN;
  347.  BEGIN
  348.   WITH BAR^ DO
  349.    do:= FALSE;
  350.    IF (dir = -3) AND (num > (start)) THEN  INC (start);  do:= TRUE; END;
  351.    IF (dir = -2) AND (start > 0) THEN  DEC (start);  do:= TRUE; END;
  352.    IF do THEN
  353.     Assign (ScrollStr, line);  l:= spos;  i:= start;
  354.     WHILE (i <= num) AND ((l + entry[i].width) < (react.w - BoxWidth)) DO
  355.      Append (entry[i].text, line);  
  356.      entry[i].pos:= l;  INC (l, entry[i].width);  INC (i);
  357.     END;
  358.     draw:= i - 1;  tr.adr:= ADR(line);  tr.d1:= 0; tr.d2:= 0;
  359.     MagicAES.WindSet (win, MagicAES.WFINFO, tr);
  360.     Bounce;
  361.    END;
  362.   END;
  363.  END ScrollMenu;
  364.  
  365. BEGIN
  366.  menu:= -1;  eintrag:= -1;
  367.  IF BAR # NIL THEN
  368.   WITH BAR^ DO
  369.    ScreenDim (mWidth, mHeight);
  370.    i:= MagicVDI.SetWritemode (PrivateWS, MagicVDI.XOR);
  371.    i:= MagicVDI.SetFillcolor (PrivateWS, 1);
  372.    bool:= MagicVDI.SetFillperimeter (PrivateWS, FALSE);
  373.    IF config = pull THEN  WindUpdate (BEGMCTRL);  END;
  374.    LOOP
  375.     MagicAES.GrafMkstate (mx, my, button, s);
  376.     j:= GetMenu (mx, my);
  377.     CASE j OF
  378.          -1:   i:= MagicVDI.SetWritemode (PrivateWS, MagicVDI.REPLACE);
  379.                IF config = pull THEN  WindUpdate (ENDMCTRL);  END;
  380.                RETURN;|
  381.      -2, -3:   IF Links IN button THEN  ScrollMenu (j);  END;|
  382.      ELSE      IF Links IN button THEN  EXIT;  END;
  383.     END;
  384.     IF config = drop THEN  EXIT;  END;
  385.    END;
  386.    IF config # pull THEN  WindUpdate (BEGMCTRL);  END;
  387.    IF j >= 0 THEN
  388.     LOOP
  389.      drp:= j;
  390.      WITH entry[j] DO
  391.       b.x:= react.x + pos;   b.y:= react.y + 1; 
  392.       b.w:= b.x + width;  b.h:= react.y + BoxHeight - 2;
  393.       IF b.w > mWidth THEN  b.w:= mWidth - 1;  END;
  394.       IF b.h > mHeight THEN  b.h:= mHeight - 1;  END;
  395.       InvertMenu;
  396.       off:= MakeMenu (j) + 1;
  397.       WITH Dropdown[0] DO
  398.        obX:= react.x + pos;  obY:= react.y + BoxHeight;
  399.        IF (obX + obWidth) > mWidth THEN  obX:= mWidth - obWidth;  END;
  400.        IF (obY + obHeight) > mHeight THEN  obY:= react.y - obHeight;  END;
  401.        sr.x:= obX - 1;  sr.y:= obY - 1;  sr.w:= obWidth + 2;  sr.h:= obHeight + 2;
  402.       END;
  403.       bool:= SaveArea (PrivateWS, menuArea, sr);
  404.       ObjcDraw (ADR (Dropdown), 0, MaxObjects, sr);
  405.       IF config = click THEN   Bounce;  END;
  406.       eintrag:= DoMenu (ADR (Dropdown), j);
  407.       IF eintrag > 0 THEN   menu:= j + 3;  INC (eintrag, off);  END;
  408.       RestoreArea (PrivateWS, menuArea);
  409.       IF (config # pull) AND (eintrag > 0) THEN  Bounce;  END;
  410.       InvertMenu;
  411.       FreeArea (menuArea);
  412.      END; (* WITH entry[j] *)
  413.      IF (j < -1) OR (j = drp) (*OR (config = pull)*) THEN  EXIT;  END;
  414.     END; (* LOOP *)
  415.    END; (* IF j > 0 *)
  416.   END; (* WITH BAR^ *)
  417.   WindUpdate (ENDMCTRL);
  418.   i:= MagicVDI.SetWritemode (PrivateWS, MagicVDI.REPLACE);
  419.  END; (* IF BAR *)
  420. END HandleMenu;
  421.  
  422. PROCEDURE ConfigMenu (conf: Config);
  423. BEGIN
  424.  config:= conf;
  425. END ConfigMenu;
  426.  
  427. BEGIN
  428.  bool:= NewAREA (menuArea);
  429.  BAR:= NIL;
  430.  ScrollStr[0]:= ' ';
  431.  ScrollStr[1]:= 4C;
  432.  ScrollStr[2]:= ' ';
  433.  ScrollStr[3]:= ' ';
  434.  ScrollStr[4]:= 3C;
  435.  ScrollStr[5]:= ' ';
  436.  ScrollStr[6]:= 0C;
  437.  config:= click;
  438.  Char3:= 3 * CharWidth;
  439.  Char6:= 6 * CharWidth;
  440. END mtMenus.
  441.  
  442.